;; import functions/repeat.scm numbers/linear-random.scm files/words.scm

(define (edge weight target) (lambda (r) (r weight target)))

(define (add-edge-aux table key k)
  (if (null? table)
      (k (list (edge 1 key)))
      (let* ((current (car table)))
        (current
         (lambda (nweight nkey)
           (if (equal? key nkey)
               (k (cons (edge (+ nweight 1) nkey) (cdr table)))
               (add-edge-aux (cdr table) key
                             (lambda (rest) (k (cons current rest))))))))))

(define (add-edge table key)
  (let ((size (cdr table)))
    (add-edge-aux (car table) key (lambda (x) (cons x (+ size 1))))))

(define (pick-random-aux table n)
  ((car table)
   (lambda (nweight nkey)
     (let ((n (- n nweight)))
       (if (< n 0)
           nkey
           (pick-random-aux (cdr table) n))))))

(define (pick-random table)
  (let ((table (car table))
        (size (cdr table)))
    (pick-random-aux table (random size))))

(define (update-alist-aux alist key update-fn empty k)
  (if (null? alist)
      (k (list (cons key (update-fn (empty)))))
      (let ((current (car alist)))
        (if (equal? key (car current))
            (k (cons (cons key (update-fn (cdr current))) (cdr alist)))
            (update-alist-aux
             (cdr alist) key update-fn empty
             (lambda (rest) (k (cons current rest))))))))

(define (add-entry graph from to)
  (let ((update (lambda (old) (add-edge old to))))
    (update-alist-aux graph from update (lambda () (cons '() 0)) (lambda (x) x))))


(define (iter model prev2 prev memo min)
  (let (;(next (pick-random (cdr (assoc (list prev2 prev) model))))
        (next (pick-random (cdr (assoc prev model)))))
    (if (null? next)
        (if (<= min 0)
            (list->string (reverse memo))
            (iter model prev2 prev memo min))
        (iter model prev next (cons next memo) (- min 1)))))

(define (name! starts model min)
  (let* ((first-letter (pick-random starts))
         (second-letter (pick-random (cdr (assoc first-letter model)))))
    (iter model first-letter second-letter (list second-letter first-letter) min)))

(define (build-names first-letters graph file)
  (for-each (lambda (word)
              (let ((word (string->list word)))
                (cond ((< 2 (length word))
                       (add-transition! first-letters (car word))
                       (add-edge! graph (car word) (cadr word))
                       (let loop ((word (cddr word))
                                  (prev-2 (car word))
                                  (prev-1 (cadr word)))
                         (if (null? word)
                             (begin
                               (add-edge! graph prev-1 '())
                               ;;(add-edge! graph (list prev-2 prev-1) '())
                                )
                             (let ((letter (car word)))
                                (add-edge! graph prev-1 letter)
                               ;;(add-edge! graph (list prev-2 prev-1) letter)
                               (loop (cdr word) prev-1 letter))))))))
            (with-input-from-file file words)))

(define (add-transition! box key)
  (set-box! box (add-edge (unbox box) key)))

(define (add-edge! box k v)
  (set-box! box (add-entry (unbox box) k v)))

(define names (box '()))
(define surnames (box '()))
(define names-start (box (cons '() 0)))
(define surnames-start (box (cons '() 0)))
(build-names names-start names "data/finnish_firstnames.txt")
(build-names surnames-start surnames "data/finnish_lastname.txt")

(repeat
 (lambda ()
   (display (name! (unbox names-start) (unbox names) 1)) (display " ")
   (display (name! (unbox surnames-start) (unbox surnames) 1)) (newline))
 100)
